home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 50
/
050.d81
/
calendar maker
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
8KB
|
225 lines
0 poke53280,6:poke53281,.:print"[147] [208]lease [215]ait...."
1 ifa=0thena=1:load"calendarfont2",8,1
2 poke55,0:poke56,140:clr:poke53272,56:poke56576,1:poke648,140
5 poke53281,.:poke646,7
10 s=54272:forn=stos+24:poken,0:next:pokes+24,13:pokes+5,240:pokes+6,44:gosub1200
11 mn$(1)=" [205][155]ake/edit notes":mn$(2)=" [195][155]ancel notes "
12 mn$(3)=" [214][155]iew note(s) ":mn$(4)=" [211][155]ave calendar"
13 mn$(5)=" [204][155]oad calendar ":mn$(6)=" [208][155]rint calendar"
14 mn$(7)=" [206][155]ew calendar ":mn$(8)=" [209][155]uit"
20 dim mo$(12),nd(12),mm(50),xm$(50,5),m2$(12):u$=chr$(221):ch$="mcvslpnq"
30 fori=1to12:readmo$(i),nd(i):next
35 fori=1to12:readm2$(i):next
40 fori=0to6:readd$:dy$=dy$+d$+" ":da$(i)=d$:next
41 forn=0to6:readd$:pd$=pd$+d$+" ":next
45 ifpeek(251)=0thengosub1350
50 fori=0to9:s$=s$+" ":next:fori=0to77:h$=h$+chr$(45):next:s1$=".........."
51 h$(1)="[176][192][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192]"
52 h$(1)=h$(1)+"[192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][174]"
53 h$(2)="[171][192][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192]"
54 h$(2)=h$(2)+"[192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][192][179]"
55 h$(3)="[173][192][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192]"
56 h$(3)=h$(3)+"[192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][189]"
57 ifpeek(251)=0thengosub1300:poke251,1
58 forn=1to39:l$=l$+chr$(32):next
59 cb$=""+l$+l$+l$+l$+l$+l$+" "
60 us$=u$+s$:print"[147] @ [208]erpetual [195]alendar [205]aker _":print:gosub560
70 gosub630
80 poke198,0:gosub360:
90 forn=1to8:ifa$=mid$(ch$,n,1)thenk=n
100 next
110 ifk<1ork>8then80
120 ifk=7thenprintcb$;l$;l$:print" "mn$(7):print" [207]ne second...":run10
130 ifk=8thengoto14900
135 forn=1985to2023:poken,32:next
140 onkgosub150,380,980,790,850,410:goto70
150 printcb$;l$;l$:print" "mn$(1)
155 print" [207][155]ne day, [215][155]eekly, or [197][155]very day[158] ";:getdd$
160 ifdd$<>"o"anddd$<>"w"anddd$<>"e"thenprint"[145][145][145]":goto155
165 print"[145][145]"s$
170 cu=1:sp=1:ifdd$="e"thencu=nd(mo):ms$="to end of month"
180 ifdd$="w"thensp=7:cu=nd(mo):ms$=" & weekly after"
190 gosub330
200 print"[147] [206]otes for "mo$(mo)dt;ms$:ms$=""
210 print" .......... 10 character maximum":printspc(24)"per line":gosub310
220 print"[145][145][145][145][145]":fori=0to5:print"";:ln=10:nu=0:gosub1100:x$=y$
230 iflen(x$)<10thenx$=x$+chr$(32):goto230
240 xm$(dt+j,i)=x$:nexti:print:print" [212]hese are the notes:":print
250 gosub321:print" [155][193]re they correct (y/n)?[158]"
260 gosub360:ifa$<>"y"thenf2=1:goto200
270 ifdd$="o"then300
280 forn=dt+jtocu+jstepsp:fori=0to5
290 xm$(n,i)=xm$(dt+j,i):nexti:mm(n-j)=1:nextn
300 return
310 fori=0to5:ifxm$(dt+j,i)=""thenxm$(dt+j,i)=s1$
311 f3=18:iff2=1thenf3=0
320 printi+1spc(1) xm$(dt+j,i):next:f2=0:gosub325:return :rem chr$(f3)
321 fori=0to5:ifxm$(dt+j,i)=""thenxm$(dt+j,i)=s1$
322 printi+1spc(1)xm$(dt+j,i):next:return
325 print""spc(20)"to edit, retype
326 [153][166]22)"entire line.":[142]
330 [153]" liststr$ate for notes: (1 -"nd(mo)"cmd) ";
335 ln[178]2:nu[178]2:[141]1100:dt$[178]y$:dt[178][197](dt$)
340 [139]dt[179]1[176]dt[177]nd(mo)[167][153]"ononon":[137]330
350 mm(dt)[178]1:[142]
360 a$[178]"":[161]a$:[139]a$[178]""[167]360
370 [142]
380 [153]cb$;l$;l$:[153]" "mn$(2)
385 [141]330:mm(dt)[178]0:[129]i[178]0[164]5
390 xm$(dt[170]j,i)[178]s$:[130]
400 [142]
410 [153]cb$;l$;l$:[153]" "mn$(6)
415 [153]" (NULL)rinter ready (y/n)?"
420 [141] 360:[139]a$[179][177]"y"[167][142]
425 [153]" graphics printer (y/n)?"
426 [141] 360:u$[178]"(NULL)":mm[178]1:[139]a$[178]"n"[167]u$[178][199](33):mm[178].:us$[178]u$[170]s$:[137]1400
427 us$[178]u$[170]s$
430 [160]4:[159]4,4:c[178]0:c1[178]1:n[178]0
440 l[178][195](m2$(mo))[173]2:[152]4,[199](14)[166]16[171]l)m2$(mo)" - "yr
450 [152]4,[199](13)[199](13)[199](14)[200](pd$,39):[152]4,[199](15)
452 [139](mm[178].)[167][152]4,h$:[137]460
455 [152]4,h$(1)
460 [129]i[178]1[164]y:[129]t[178]0[164]6:c[178]c[170]1
470 [139]c[178][179]j[176]n[178][177]nd(mo)[167][152]4,us$;:[137]500
480 n[178]n[170]1:n$[178]" "[170][202]([196](n),2)
490 [152]4,[200](us$,7)[199](14)[201](n$,2)[199](15);
500 [130]t:[152]4,u$
510 [129]t1[178]0[164]5:[129]t2[178]0[164]6
520 [139] xm$(c1[170]t2,t1)[178]""[167][152]4,us$;:[137]540
530 [152]4,u$[170]xm$(c1[170]t2,t1);
540 [130]t2:[152]4,u$:[130]t1:c1[178]c1[170]7:[139](mm[178].)[167][152]4,h$:[137]550
545 [139](i[178]y)[167][152]4,h$(3):[137]550
547 [152]4,h$(2)
550 [130]i:[152]4:[160]4:[142]
560 ln[178]2:nu[178]2:[153]" list(NULL)hich month (1-12) sys";:[141]1100
565 mo[178][197](y$):[139]mo[179]1[176]mo[177]12[167][153]"onon":[137]560
570 ln[178]5:nu[178]2:[153]" list(NULL)hat year (xxxx) sys";:[141]1100
575 yr[178][197](y$):[139]yr[179]1583[167][153]"ononon":[137]570
580 q[178]yr[170](mo[179]3):j[178][181](275[172]mo[173]9)[171][181]((7[172]q[170]7)[173]4)[170]367[172]yr[170]1[171][181](([181](q[173]100)[170]1)[172]3[173]4)
590 j[178]j[171]4[171]7[172][181]((j[171]4)[173]7):x[178](nd(mo)[170]j)[173]7:y[178][181](x):[139]x[177]y[167]y[178]y[170]1
600 [139]mo[179][177]2[176](yr[173]4)[179][177][181](yr[173]4)[167]620
605 [139](yr[173]400)[178][181](yr[173]400)[167]615
610 [139](yr[173]100)[178][181](yr[173]100)[167]620
615 nd(mo)[178]29
620 [142]
630 [153]"load @ open(NULL)erpetual lenalendar sys_"
640 [153]"cont"[166]10[171][195](mo$(mo))[173]2)mo$(mo):[153]"on"[166]26)yr
650 [153]:[153][166]3)dy$:[153]"sys":c[178]0:n[178]0
660 [129]i[178]1[164]y:[129]t[178]1[164]7:c[178]c[170]1:[139]c[178][179]j[167][153][166]5):[137]700
670 [139]n[178][177]nd(mo)[167]700
680 n[178]n[170]1:n$[178]" "[170][202]([196](n),2)
690 [153][166]3)[201](n$,2)[199](146);:[139]mm(n)[167][153]"*cmdsys";
700 [130]t:[153]:[153]:[130]i
710 [153]mn$(1)mn$(2)
720 [153]mn$(3)mn$(4)
730 [153]mn$(5)mn$(6)
735 [153]mn$(7)mn$(8)
740 [153]" *list means this date has notes
750 printspc(5)"@ [155][212]ype in letter of choice _[158]":return
760 data"[202]anuary",31,"[198]ebruary",28,"[205]arch",31,"[193]pril",30,"[205]ay",31,"[202]une",30
761 data "[202]uly",31
770 data"[193]ugust",31,"[211]eptember",30,"[207]ctober",31,"[206]ovember",30,"[196]ecember",31
771 datajanuary,february,march,april,may,june,july,august,september,october
772 data november,december
780 data"[211]un","[205]on","[212]ue","[215]ed","[212]hu","[198]ri","[211]at"
781 datasun,mon,tue,wed,thu,fri,sat
790 printcb$;l$;l$:print" "mn$(4)
795 ln=12:nu=0:print" [155][206]ame of file: ";:gosub1100:su$=y$:su$=left$(su$,12)
796 open3,8,3,+su$+" "+left$(mo$(mo),3)+",s,w"
800 print" [211]aving "su$+" "+left$(mo$(mo),3)
810 forn=jtond(mo)+j:forr=0to5:ifxm$(n,r)=s$orxm$(n,r)=""thenxm$(n,r)="."
820 print#3,xm$(n,r):next:next
830 gosub950:iffl=1thenfl=0:goto840
840 close3:return
850 printcb$;l$;l$:print" "mn$(5)
855 ln=12:nu=0:print" [155][206]ame of file: ";:gosub1100:su$=y$:su$=left$(su$,12)
856 open3,8,3,+su$+" "+left$(mo$(mo),3)+",s,r"
870 print" [204]oading "su$+" "+left$(mo$(mo),3)
875 forn=1to37:mm(dt)=0:next
880 forn=jtond(mo)+j:forr=0to5
890 input#3,xm$(n,r)
900 ifxm$(n,r)="."thenxm$(n,r)=s$:goto920
910 mm(n-j)=1
9